home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Leser 15 / Amiga Plus Leser CD 15.iso / Games / Centipede / Centipede.Bak / Centipede.amosSourceCode < prev    next >
AMOS Source Code  |  2002-03-13  |  10KB  |  576 lines
  1. Rem *** CENTIPEDE DX *** 
  2. Rem *** MILLENNIUM EDITION *** 
  3. Rem (c) 1999 by Norman Walter
  4.  
  5. Dim X(20),Y(20),SPEED(20),CLIMB(20),HITPOINTS(20),NAME$(9),SCORE(9)
  6. Global X(),Y(),S,MUSHROOMS,SPEED(),CLIMB(),ELEMENTS,HITPOINTS(),ALLHITPOINTS,Z
  7. Global LIVES,SCORE,SCORE(),NAME$(),GAMEMODE$,HSC$
  8.  
  9. HSC$="Centipede_Hiscore"
  10.  
  11. Make Mask 
  12.  
  13.  
  14. HISCORE_LOAD[HSC$]
  15.  
  16. GAMEMODE$="NORMAL"
  17.  
  18. Do 
  19.  TITLE
  20.  MAINLOOP
  21. Loop 
  22.  
  23. Procedure MAINLOOP
  24.  
  25. If GAMEMODE$="EASY"
  26.  S=2 : MUSHROOMS=1
  27. End If 
  28.  
  29. If GAMEMODE$="NORMAL"
  30.  S=4 : MUSHROOMS=2
  31. End If 
  32.  
  33. If GAMEMODE$="HARD"
  34.  S=4 : MUSHROOMS=4
  35. End If 
  36.  
  37.  LIVES=3 : SCORE=0
  38.  ELEMENTS=6 : Rem Anzahl der Elemente des Wurms
  39.  
  40.  While LIVES>0
  41.   INIT
  42.   GAMELOOP
  43.   If ELEMENTS<15 Then Inc ELEMENTS
  44.  Wend 
  45.  
  46. Rem *** Game Over ***
  47.  
  48. Bob Off : Sprite Off 
  49. Wait Vbl 
  50.  
  51. Load Iff "GAME_OVER.iff",0
  52. MWAIT[300]
  53.  
  54.  HISCORE_ENTER[SCORE]
  55.  HISCORE_SAVE[HSC$]
  56.  
  57. End Proc
  58.  
  59. Procedure INIT
  60.  
  61.  Screen Open 0,320,256,32,Lowres
  62.  Curs Off : Flash Off : Hide 
  63.  Get Bob Palette : Cls 0
  64.  
  65.  Limit Mouse 136,257 To 440,291
  66.  
  67.  GIRD
  68.  Double Buffer 
  69.  Synchro Off 
  70.  Update Off 
  71.  
  72.  I=ELEMENTS*16 : Rem Anfangsposition des Kopfs
  73.  ALLHITPOINTS=0
  74.  
  75. W$="Anim 0,(7,4)(8,4)(7,4)(9,4)"
  76. W$=W$+"Start:"
  77. W$=W$+"Let X=R0;Let Y=R1"
  78. W$=W$+"Jump Start"
  79.  
  80. Rem Anfangspositionen der Elemente 
  81.  
  82. For E=1 To ELEMENTS
  83.  Add I,-16
  84.  HITPOINTS(E)=2
  85.  Add ALLHITPOINTS,2
  86.  SPEED(E)=S
  87.  CLIMB(E)=16
  88.  X(E)=I
  89.  Y(E)=8
  90.  Bob E,X(E),Y(E),1
  91.  Channel E To Bob E
  92.  Amal E,W$
  93.  Amal On E
  94. Next E
  95.  
  96. HITPOINTS(1)=1 : Rem Kopf des Wurms 
  97. Dec ALLHITPOINTS
  98. CHANGEHEAD[1]
  99.  
  100. End Proc
  101.  
  102. Procedure GAMELOOP
  103.  
  104. While LIVES>=1 and ALLHITPOINTS>0
  105.  
  106. ESCAPE
  107. GUN
  108. CRASH : Rem Kollisionsabrage 
  109.  
  110. WORMMOVE
  111.  
  112.  Synchro 
  113.  Update 
  114.  Wait Vbl 
  115.  
  116. DISPLAY
  117.  
  118. Wend 
  119.  
  120. End Proc
  121.  
  122.  
  123. Procedure GIRD
  124.  
  125. Reserve Zone 320
  126.  
  127. Z=1
  128.  
  129.  For Y=0 To 240 Step 16
  130.   For X=0 To 304 Step 16
  131.    Rem Ink 1 : Box X,Y To X+16,Y+16 
  132.     If Y>16 and Y<208 and Rnd(20/MUSHROOMS)=1
  133.      Rem Set Zone Z,X,Y To X+16,Y+16 : Inc Z
  134.      Paste Bob X,Y,3
  135.     End If 
  136.   Next X
  137.  Next Y
  138. End Proc
  139.  
  140. Procedure WORMMOVE
  141.  
  142. For E=1 To ELEMENTS
  143.  
  144. Rem *** Bedingungen zum Umkehren *** 
  145.  
  146. Add X(E),SPEED(E)
  147.  
  148. TURN=X(E)>=312 or X(E)<=0 or Point(X(E)+7,Y(E))=10 or Point(X(E)-7,Y(E))=10 : Rem or Zone(X(E),Y(E))<>0
  149. EDGE=Y(E)>248 or Y(E)<8
  150.  
  151. If Bob Col(E,1 To ELEMENTS)<>0
  152. Rem CLIMB(E)=-CLIMB(E) 
  153. Rem Add Y(E),CLIMB(E)
  154. End If 
  155.  
  156. If EDGE
  157.  If Y(E)>284 : CLIMB(E)=-16 : End If 
  158.  If Y(E)<8 : CLIMB(E)=16 : End If 
  159.  TURN=True
  160. End If 
  161.  
  162. If TURN
  163.  SPEED(E)=-SPEED(E)
  164.  Add Y(E),CLIMB(E)
  165.   If HITPOINTS(E)=1
  166.     CHANGEHEAD[E]
  167.   End If 
  168. End If 
  169.  
  170.  If HITPOINTS(E)=0
  171.   Bob Off E : Amal Off E
  172.  End If 
  173.  
  174. Rem *** Koordinaten des Segments an Amalregister ï¿½bergeben *** 
  175.  
  176.  If HITPOINTS(E)<>0
  177.   Amreg(E,0)=X(E) : Amreg(E,1)=Y(E)
  178.  End If 
  179.  
  180. Next E
  181.  
  182. End Proc
  183.  
  184. Procedure CHANGEHEAD[E]
  185.  
  186.  Rem *** Animationsrichtung des Kopfes ï¿½ndern *** 
  187.  
  188.     Amal Off E
  189.  
  190.     If Sgn(SPEED(E))=1
  191.      W$="Anim 0,(10,4)(11,4)(10,4)(12,4)"
  192.     Else 
  193.       W$="Anim 0,(13,4)(14,4)(13,4)(15,4)"
  194.     End If 
  195.  
  196.     W$=W$+"Start:"
  197.     W$=W$+"Let X=R0;Let Y=R1"
  198.     W$=W$+"Jump Start"
  199.  
  200.     Amal E,W$
  201.     Amal On E
  202.  
  203. End Proc
  204.  
  205.  
  206. Procedure DISPLAY
  207.  If Chanmv(0)=0 Then Sprite Off 0 : Rem Schuss Ausblenden
  208.  Bob 0,X Screen(X Mouse),Y Screen(Y Mouse),2
  209.  Synchro 
  210.  Update 
  211.  Wait Vbl 
  212. End Proc
  213.  
  214. Procedure CRASH
  215.  
  216.  Rem *** Spieler ber�hrt? *** 
  217.  
  218.  If Bob Col(0)<>0
  219.   Boom 
  220.   Dec LIVES
  221.  End If 
  222.  
  223. If Chanmv(0)<>0
  224.  
  225.  Rem *** Abfrage, ob Wurm getroffen *** 
  226.  
  227.  If Spritebob Col(0,1 To ELEMENTS)<>0
  228.    Sprite Off 0 : Rem *** Schuss Ausblenden ***
  229.     Boom 
  230.     Add SCORE,100
  231.     Rem *** Welches Element wurde getroffen? *** 
  232.     E=1 : While Not Col(E) : Inc E : Wend 
  233.     Dec HITPOINTS(E) : Dec ALLHITPOINTS
  234.     Rem *** Neuer Pilz *** 
  235.      Rem Ink 2 : Box X(E)-8,Y(E)-8 To X(E)+8,Y(E)+8 
  236.      Rem Set Zone Z,X(E)-8,Y(E)-8 To X(E)+8,Y(E)+8 : Inc Z
  237.      Paste Bob X(E)-8,Y(E)-8,3
  238.     Rem *** Neue Position des neuen Kopfs ***
  239.     Add Y(E),CLIMB(E)
  240.      SPEED(E)=-SPEED(E) : Add X(E),Sgn(SPEED(E))*16
  241.     CHANGEHEAD[E]
  242.   End If 
  243.  
  244.  XS=X Screen(X Sprite(0)) : YS=Y Screen(Y Sprite(0))
  245.  
  246.  Rem *** Pilz getroffen? ***
  247.  
  248.  If Point(XS,YS)<>0 : Rem Hzone(X Sprite(0),Y Sprite(0))<>0
  249.   Sprite Off 0
  250.   Ink 0 : Bar XS-10,YS-2 To XS+10,YS+10
  251.   Inc SCORE
  252.  End If 
  253.  
  254. End If 
  255.  
  256. End Proc
  257.  
  258. Procedure GUN
  259.  If Mouse Key and Chanmv(0)=0
  260.   Channel 0 To Sprite 0
  261.   Sprite 0,X Mouse,Y Mouse-16,4
  262.      Amal 0,"Move 0,-256,32" : Amal On 0 : Shoot : Rem Pfeil mit Amal abschie�en
  263.  End If 
  264. End Proc
  265.  
  266. Procedure ESCAPE
  267.  If Asc(Inkey$)=27 Then End 
  268. End Proc
  269.  
  270. Procedure MWAIT[T]
  271.  
  272. Rem *** Wartet auf Mouseclick oder bis angegebene Zeit T erreicht ***
  273.  
  274.  If T<>0 Then Timer=0
  275.   Repeat 
  276.    If Asc(Inkey$)=27 Then End 
  277.  Until Mouse Key or Timer=T
  278.  
  279. End Proc
  280.  
  281. Procedure HISCORE_DISPLAY
  282. Dim C(16)
  283. Load Iff "Hiscores.iff",0
  284. Rem Screen Open 0,320,256,32,Lowres : Curs Off : Flash Off : Cls 0 
  285. Rem Get Bob Palette  
  286. Paper 0 : Auto View Off 
  287. Rem Flash 14,"(666,15)(FFF,10)"
  288. Rem Pen 2 : Locate 0,0 : Centre "Highscores" 
  289. Rem Pen 4 : Locate 0,2 : Centre "Top 10" 
  290.  
  291.    ' Display the 10 names using a FOR..NEXT loop  
  292.    '  
  293.    Ink 15,0,0
  294.    For I=0 To 9
  295.       YP=82+I*9
  296.       SCORE$=Mid$(Str$(SCORE(I)),2)
  297.    LS=Text Length(SCORE$)
  298.   Set Font SCH
  299.       Text 30,YP,Str$(I+1)+"."
  300.       Text 70,YP,NAME$(I)
  301.       Text 290-LS,YP,SCORE$
  302.    Next I
  303.    '
  304. Wait Vbl : View 
  305. Auto View On 
  306.  
  307. Rem Flash 14,"(666,15)(FFF,10)" : Paper 0
  308. End Proc
  309.  
  310. Procedure HISCORE_ENTER[SCORE]
  311.    '
  312.    If SCORE>SCORE(9)
  313.       '
  314.       ' Find the position of our new score in the table
  315.       POS=0
  316.       While SCORE<=SCORE(POS)
  317.          POS=POS+1
  318.       Wend 
  319.       '  Move the lower scores one place down  
  320.       For I=9 To POS+1 Step -1
  321.          NAME$(I)=NAME$(I-1)
  322.          SCORE(I)=SCORE(I-1)
  323.       Next I
  324.       NAME$(POS)=""
  325.       SCORE(POS)=SCORE
  326.       '
  327.        HISCORE_DISPLAY
  328.       Pen 14 : Locate 0,4 : Centre "please enter your name !"
  329.  
  330.       XC=100 : YC=60
  331.       '
  332.       ' Display Cursor 
  333.       Gosub CURSEUR
  334.       '
  335.       ' Input the name using a REPEAT..UNTIL loop
  336.       Repeat 
  337.          ' Read keyboard  
  338.          K$=Inkey$
  339.          K=Asc(K$)
  340.          L=Len(NAME$)
  341.          ' Handle Backspace 
  342.          If K=8 and L>0
  343.             DC=0
  344.             XC=XC-8
  345.             Text XC,YC,"  "
  346.             Gosub CURSEUR
  347.             NAME$=Left$(NAME$,L-1)
  348.          End If 
  349.          ' Handle cursor  
  350.          If K>13 and L<15
  351.             DC=8
  352.             Ink 14 : Text XC,YC,K$
  353.             XC=XC+8
  354.             Gosub CURSEUR
  355.             NAME$=NAME$+K$
  356.          End If 
  357.          '
  358.          ' Repeat until a carriage return.  
  359.       Until K=13
  360.      If Len(NAME$)=0 : NAME$="Mr Noname" : End If 
  361.       ' Put the new name into the NAME$ array  
  362.       NAME$(POS)=NAME$
  363.       SCORE(POS)=SCORE
  364.       '
  365.     Rem Flash Off  
  366.       '
  367.    End If 
  368.    '
  369.    ' Display final array, and return! 
  370.    HISCORE_DISPLAY
  371.    '
  372.    Pop Proc
  373.    '
  374.    '  Simulate a 'fake' text cursor using the DRAW command  
  375.    CURSEUR:
  376.    Ink 14 : Draw XC,YC To XC+5,YC
  377.    Return 
  378.    '
  379. End Proc
  380.  
  381. Procedure HISCORE_LOAD[N$]
  382.    '
  383. Request Off : On Error Goto FAILURE
  384.    '
  385.    ' Open a simple sequential file
  386.    Open In 1,N$
  387.    ' Read the names and scores from the disc
  388.    For I=0 To 9
  389.       Line Input #1,NAME$(I),SCORE$
  390.       SCORE(I)=Val(SCORE$)
  391.    Next I
  392.    ' Close up the file  
  393.    Close 1
  394.    '
  395.    SKIP:
  396.    Pop Proc
  397.    '
  398.    FAILURE:
  399.    Resume SKIP
  400.    '
  401. End Proc
  402.  
  403. Procedure HISCORE_SAVE[HSC$]
  404.  
  405. Pen 14 : Locate 0,25 : Centre "Do you want to save Highscores ? (y/n)"
  406. Repeat 
  407.  K=Asc(Inkey$)
  408.   If K=110 Then Exit : Rem n
  409.   If K=121 Then Goto STORE : Rem y  
  410. Until K=110 or K=121
  411.  Locate 0,25 : Cline 
  412. Pop Proc
  413.  '
  414. STORE:
  415.  Locate 0,25 : Cline 
  416.    On Error Proc DISKERROR
  417.    Resume Label LEAVE
  418.    ' Create a simple sequential file  
  419.    Open Out 1,HSC$
  420.    ' Write the names and scores to the new file 
  421.    For I=0 To 9
  422.       Print #1,NAME$(I)
  423.       Print #1,Str$(SCORE(I))
  424.    Next I
  425.    ' Close the file (ESSENTIAL!)
  426.    Close 1
  427.    '
  428. LEAVE:
  429.  Pop Proc
  430.  
  431. End Proc
  432.  
  433.  
  434. Procedure DISKERROR
  435.  
  436. FAILURE:
  437.  
  438. Rem *** The error handling routine 
  439.  
  440. HELP:
  441. Request Off 
  442. Auto View Off 
  443. Screen Open 2,640,150,16,Hires : Curs Off : Flash Off : Cls 0
  444. Get Icon Palette 
  445. Rem Palette ,,,,,,,,,,,,,$F59,$59F,$FF 
  446. Screen Display 2,,100,,
  447.  
  448. Paste Icon 10,10,1
  449.  
  450. Pen 2 : Paper 0
  451.  
  452. Locate 35,1 : Print "Disk error"
  453.  
  454. If Errn=84
  455.  Locate 35,3 : Print "Disk is write protected."
  456.  Locate 35,4 : Print "Please slide tab to the open position."
  457. End If 
  458.  
  459. If Errn=93
  460.  Locate 35,3 : Print "No disk in drive."
  461.  Locate 35,4 : Print "Please re-insert your game-disk."
  462. End If 
  463.  
  464. Pen 14 : Locate 35,7 : Print "PRESS MOUSE BUTTON TO TRY AGAIN"
  465. Pen 13 : Locate 35,9 : Print "PRESS ESC TO CANCEL"
  466.  
  467. Auto View On 
  468.  
  469. '
  470. Rem *** Wait for users choice
  471. Repeat 
  472.  K$=Inkey$ : K=Asc(K$)
  473.  F=Mouse Click
  474. Until K=27 or F<>0
  475. '
  476. Rem *** remove error routine's screen
  477.  
  478. Screen Close 2
  479. '
  480. Rem *** Exit routine *** 
  481. If F<>0 Then Resume 
  482.  
  483. Resume Label 
  484.    '
  485. End Proc
  486.  
  487.  
  488. Procedure OPTIONS
  489.  
  490. Open In 1,"Options.Anim5"
  491. L=Frame Load(1 To 10,1000)
  492. Close 
  493.  
  494.  P=Frame Play(10,1,0)
  495.  Double Buffer 
  496.  
  497. Do 
  498.  
  499.  P=10
  500.  
  501.  For X=1 To 72
  502.   P=Frame Play(P,1)
  503.   Screen Swap 
  504.   Wait 2
  505.    If X=1 or X=24 or X=48 or X=72
  506.     Repeat 
  507.      If Mouse Key=1
  508.       If X=1 : GAMEMODE$="NORMAL" : End If 
  509.       If X=24 : GAMEMODE$="EASY" : End If 
  510.       If X=48 : GAMEMODE$="HARD" : End If 
  511.        Pop Proc
  512.      End If 
  513.    Until Mouse Key=2
  514.    End If 
  515.  Next X
  516.  
  517. Loop 
  518.  
  519. Erase 10
  520.  
  521. End Proc
  522.  
  523.  
  524. Procedure TITLE
  525.  
  526. Do 
  527.  
  528. Screen Open 0,320,256,4,Lowres
  529. Curs Off : Flash Off : Hide : Cls 0
  530.  
  531. Open In 1,"Intro.Anim5"
  532. L=Frame Load(1 To 10,1000)
  533. Close 
  534.  
  535.  P=Frame Play(10,1,0)
  536.  Double Buffer 
  537.  
  538.  P=10
  539.  
  540.  For X=1 To 4
  541.   P=Frame Play(P,1)
  542.   Screen Swap 
  543.     MWAIT[100]
  544.  Next X
  545.  
  546. Fade 5
  547. MWAIT[100]
  548.  
  549. Erase 10
  550.  
  551. For I=1 To 5
  552.  
  553. Load Iff "Wurm.iff",0
  554. MWAIT[150]
  555. Load Iff "centipede.iff",0
  556.  
  557. Paper 0 : Pen 10
  558. Locate 0,25 : Centre "press left mouse key to start"
  559. Locate 0,27 : Centre "press right mouse key for options"
  560.  
  561. Timer=0
  562.  
  563. Repeat 
  564.  If Mouse Key=1 Then Pop Proc
  565.  If Mouse Key=2 Then OPTIONS
  566.  If Asc(Inkey$)=27 Then End 
  567. Until Timer=400
  568.  
  569. HISCORE_DISPLAY
  570. MWAIT[400]
  571.  
  572. Next I
  573.  
  574. Loop 
  575.  
  576. End Proc